(* bunkplan.ml - Generate (crappy) HTML bunkplans from CSV               *)
(* Copyright (C) 2012  Jack Kelly                                        *)
(*                                                                       *)
(* This program is free software: you can redistribute it and/or modify  *)
(* it under the terms of the GNU General Public License as published by  *)
(* the Free Software Foundation, either version 3 of the License, or     *)
(* (at your option) any later version.                                   *)
(*                                                                       *)
(* This program is distributed in the hope that it will be useful,       *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
(* GNU General Public License for more details.                          *)
(*                                                                       *)
(* You should have received a copy of the GNU General Public License     *)
(* along with this program.  If not, see <http://www.gnu.org/licenses/>. *)

open ExtList;;
open ExtString;;

module IntMap = Map.Make (struct type t = int let compare = compare end);;
module StringMap = Map.Make (String);;

type crew_type =
    CO
  | Chef
  | Mate of int
  | Passenger
  | Watch_Assistant
  | Watch_Leader;;

type watch = Red | White | Blue;;
let watch_to_string w =
  match w with
    Red -> "RED"
  | White -> "WHITE"
  | Blue -> "BLUE"
let watch_to_string_color w =
  match w with
    Red -> "<font color=\"red\">RED</font>"
  | White -> "WHITE"
  | Blue -> "<font color=\"blue\">BLUE</font>"

type sex = Male | Female;;
type bunk_definition = {
    number: int;
    cabin: string;
    bunk_name: string;
  };;
type bunk_assignment = {
    muster_number: int;
    crew_type: crew_type;
    watch: watch;
    name: string;
    sex: sex;
    bunk_number: int;
    liferaft: string;
    emergency_station: string;
  };;
type bunkplan = {
    assignment: bunk_assignment list;
    bunks: bunk_definition list;
  };;

(* Split the rows of the CSV file into the bunkplan, bunks and
   excludes sections. *)
let split rows =
  let chunk list mark =
    let not_mark row = List.hd row <> mark
    and not_hash row = (List.hd row).[0] <> '#' in
    List.takewhile not_hash (List.tl (List.dropwhile not_mark list))
  in
  let assignments = chunk rows "#BUNKPLAN"
  and bunks = chunk rows "#BUNKS"
  and excludes = chunk rows "#EXCLUDE"
  in
  assignments, bunks, excludes;;

(* Parse the watchbill *)
let parse_assignments assignments =
  let rec iter assignments acc =
    match assignments with
      [] -> List.rev acc
    | [num;crew_type;watch;name;sex;bunk;liferaft;emergency_station]::tl ->
        iter tl ({ muster_number=int_of_string num;
                   crew_type=(match crew_type with
                     "CO" -> CO
                   | "CH" -> Chef
                   | "M1" -> Mate 1
                   | "M2" -> Mate 2
                   | "M3" -> Mate 3
                   | "WA" -> Watch_Assistant
                   | "WL" -> Watch_Leader
                   | "" -> Passenger
                   | _ -> failwith "Invalid passenger type.");
                   watch=(match watch with
                     "R" -> Red
                   | "W" -> White
                   | "B" -> Blue
                   | _ -> failwith "Invalid watch.");
                   name=name;
                   sex=(match sex with
                     "M" -> Male
                   | "F" -> Female
                   | _ -> failwith "Invalid sex.");
                   bunk_number=int_of_string bunk;
                   liferaft=liferaft;
                   emergency_station=emergency_station }::acc)
    | _ -> failwith "Format error in watchbill." in
  iter assignments [];;

(* Parse bunk definitions *)
let parse_bunks bunks =
  let rec iter bunks acc =
    match bunks with
      [] -> List.rev acc
    | [num;cabin;name]::tl -> iter tl ({ number=int_of_string num;
                                         cabin=cabin;
                                         bunk_name=name }::acc)
    | _ -> failwith "Format error in bunk definition."
  in iter bunks [];;

(* Turn a filename into a watchbill and bunk definitions *)
let read_bunkplan filename =
  let tidy = List.map (List.map (fun s -> String.uppercase (String.strip s)))
  and csv = List.filter (fun x -> x <> []) (Csv.trim (Csv.load filename)) in
  let assignments, bunks, excludes = split (tidy csv) in
  let watchbill = parse_assignments assignments
  and bunk_def = parse_bunks bunks
  and excludes = List.concat excludes in
  watchbill, bunk_def, excludes;;

let doctype = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">\n";;

(* Print one cabin plan *)
let print_cabin template_filename bunks_by_number name cabin =
  if cabin = [] then () else
  let size = List.length cabin
  and filename = (Filename.chop_extension
                    template_filename) ^ "-" ^ name ^ ".html" in
  let chan = open_out filename in
  let out = output_string chan
  and printf = Printf.fprintf chan in
  let cell = printf "<td><center>%s</center></td>" in
  let heading = printf "<td><center><font color=\"darkblue\"><u>%s</u></font></center></td>" in
  out doctype;
  out "<html>\n";
  out "<head>\n";
  printf "<title>BUNK PLAN %s</title>\n" name;
  out "</head>";
  out "<body>\n";
  if size <= 4 then out "<br /><br /><br /><br /><br /><br />";
  printf "<h1 align=\"center\">BUNK PLAN %s</h1>\n" name;
  out "<center>\n";
  if size > 4 then
    out "<font size=\"5\">"
  else
    out "<font size=\"6\">";
  out"<b>\n";
  out "<table cellpadding=\"5\" cellspacing=\"40\">\n";
  out "<tr>";
  heading "BUNK";
  heading "WATCH";
  heading "NAME";
  out "</tr>\n";
  List.iter (fun p ->
    out "<tr>";
    cell ((IntMap.find p.bunk_number bunks_by_number).bunk_name);
    cell (watch_to_string_color p.watch);
    cell p.name;
    out "</tr>\n") (List.sort ~cmp:(fun a b ->
      compare a.bunk_number b.bunk_number) cabin);
  out "</table>\n";
  out "</b></font>\n";
  out "</center>\n";
  out "</body>\n";
  out "</html>\n";
  close_out chan;;

(* Print the watchbill *)
let print_watchbill template_filename bunks_by_number watchbill =
  let filename = (Filename.chop_extension
                    template_filename) ^ "-WATCHBILL.html" in
  let chan = open_out filename in
  let out = output_string chan
  and printf = Printf.fprintf chan in
  let red = printf "<font color=\"red\">%s</font>" in
  out doctype;
  out "<html>\n";
  out "<head>\n";
  out "<title>WATCH AND STATION BILL</title>\n";
  out "</head>\n";
  out "<body>\n";
  out "<center><font face=\"sans\">\n";
  out "<table border=\"2\" rules=\"all\">\n";
  out "<tr><td colspan=\"7\">";
  out "<center>WINDEWARD BOUND<br />WATCH AND STATION BILL</center>";
  out "</td></tr>\n";
  let watch_head watch =
    out "<tr style=\"border:solid 2px\"><td><center>";
    red "NO.";
    out "</center></td><td><center>";
    red ((watch_to_string watch) ^ " WATCH");
    out "</center></td><td><center>";
    red "BUNK";
    out "</center></td><td><center>";
    red "GEAR";
    out "</center></td><td><center>";
    red "CABIN";
    out "</center></td><td><center>";
    red "LIFERAFT";
    out "</center></td><td><center>";
    red "EMERGENCY STATION";
    out "</center></td></tr>\n"; in
  let name_cell entry =
    let bgcell label =
      "<td bgcolor=\"#6666ff\">" ^ label ^ "</td>"
    and nth n =
      match n with
        1 -> "1st"
      | 2 -> "2nd"
      | 3 -> "3rd"
      | _ -> failwith "Unexpected number"
    and passenger_cell sex name =
      let color = match sex with Male -> "blue" | Female -> "red" in
      "<td><font color=\"" ^ color ^ "\">" ^ name ^ "</font></td>"
    in
    match entry.crew_type with
      CO -> bgcell ("CAPTAIN - " ^ entry.name)
    | Chef -> bgcell ("COOK - " ^ entry.name)
    | Mate n -> bgcell ((nth n) ^ " MATE " ^ entry.name)
    | Passenger -> passenger_cell entry.sex entry.name
    | Watch_Assistant -> "<td>" ^ entry.name ^ "</td>"
    | Watch_Leader -> bgcell ("LEADER - " ^ entry.name) in
  let watch_line entry =
    out "<tr><td>";
    red ("<center>" ^ (string_of_int entry.muster_number) ^ "</center>");
    out "</td>";
    out (name_cell entry);
    out ("<td><center>" ^ (string_of_int entry.bunk_number) ^ "</center></td>");
    out "<td></td>";
    out "<td><center>";
    out (IntMap.find entry.bunk_number bunks_by_number).cabin;
    out "</center></td>";
    printf "<td><center>%s</center></td>" entry.liferaft;
    printf "<td><center>%s</center></td></tr>\n" entry.emergency_station in
  watch_head Red;
  let rec iter watchbill watch =
    match watchbill with
      [] -> ()
    | hd::tl ->
        if hd.watch <> watch then watch_head hd.watch;
        watch_line hd;
        iter tl hd.watch
  in
  iter (List.sort
             ~cmp:(fun a b -> compare a.muster_number b.muster_number)
             watchbill) Red;
  out "</table>\n";
  out "</font></center>\n";
  out "</body>\n";
  out "</html>\n";
  close_out chan;;

(* Build and print the cabin plans *)
let make_cabins filename watchbill bunks excludes =
  (* Build a map of the watchbill, by bunk *)
  let wb_by_bunk =
    let rec iter watchbill map =
      match watchbill with
        [] -> map
      | hd::tl -> iter tl (IntMap.add hd.bunk_number hd map)
    in iter watchbill IntMap.empty in

  (* And a map of the bunks, by bunk number *)
  let bunks_by_number =
    let rec iter bunks map =
      match bunks with
        [] -> map
      | hd::tl -> iter tl (IntMap.add hd.number hd map)
    in iter bunks IntMap.empty in

  (* And a map of the cabins, by their cabin name *)
  let bunks_by_cabin =
    let rec iter cabins map =
      match cabins with
        [] -> StringMap.map List.rev map
      | hd::tl -> try
          let cabin = StringMap.find hd.cabin map in
          iter tl (StringMap.add hd.cabin (hd::cabin) map)
      with Not_found -> iter tl (StringMap.add hd.cabin [hd] map)
    in iter bunks StringMap.empty in

  (* And now a map of the people in the cabin *)
  let cabins = StringMap.map (fun cabin ->
    List.filter_map (fun bunk ->
      try
        Some (IntMap.find bunk.number wb_by_bunk)
      with Not_found -> None) cabin) bunks_by_cabin in

  (* Filter out the excluded cabins. StringMap.filter is not yet in my
     version of ocaml. *)
  let cabins = ref cabins in
  List.iter (fun cabin ->
    cabins := StringMap.remove cabin !cabins)
    excludes;
  let cabins = !cabins in

  (* Now print the cabin definitions! *)
  StringMap.iter (print_cabin filename bunks_by_number) cabins;
  print_watchbill filename bunks_by_number watchbill;;

let make_bunkplan filename =
  let watchbill, bunk_def, excludes = read_bunkplan filename in
  make_cabins filename watchbill bunk_def excludes;;

let main () =
  let nargs = Array.length Sys.argv in
  if nargs = 2 then
    make_bunkplan Sys.argv.(1)
  else begin
    print_endline "Must have a single filename argument.";
    exit 1
  end;;

main ();;
